home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #2 / Amiga Plus CD - 2004 - No. 02.iso / AmiSoft / Dev / lang / amigatalk.lha / intuition / Boopsi.st < prev    next >
Text File  |  2003-12-18  |  17KB  |  570 lines
  1. " -------------------------------------------------------------------- "
  2. " The Boopsi Class implements the AmigaTalk to BOOPSI functions.       "
  3. " I'm NOT going to document how existing BOOPSI classes are imple-     "
  4. " mented, you'll have to find that information from someone else!      "
  5. " This class is equivalent to rootclass, since rootclass has no attri- "
  6. " butes.                                                               "
  7. ""
  8. " tag values are obtained via                                          "
  9. "    'tagValue <- boopsiObj boopsiTag: #TAG_SYMBOL'                    "
  10. ""
  11. " See BOOPSITags.st for special tags used by the BOOPSI system & look  "
  12. " at BoopsiClassNames.st                                               "
  13. " -------------------------------------------------------------------- "
  14.  
  15. Class Boopsi :Object 
  16. ! private rastPortObj iclassObj boopsiNames boopsiTags !
  17. [
  18.    dispose 
  19.  
  20.       " You eventually free the object using this method: "
  21.       <primitive 238 16 private>.
  22.       
  23.       <primitive 250 5 0 private>.
  24.  
  25.       ^ nil
  26. |
  27.    disposeObject: boopsiObject
  28.    
  29.       <primitive 238 16 boopsiObject>.
  30.       
  31.       <primitive 250 5 0 boopsiObject>.
  32.       
  33.       ^ nil      
  34. |
  35.    new
  36.  
  37.       (boopsiNames isNil)
  38.          ifTrue: [ boopsiNames <- BoopsiClassNames new ].
  39.  
  40.       (boopsiTags isNil)
  41.          ifTrue: [ boopsiTags <- BoopsiTags new ].
  42.                    
  43.       ^ self
  44. |
  45.    boopsiTag: tagSymbol
  46.    
  47.       ^ boopsiTags systemTag: tagSymbol
  48. |
  49.    newBoopsiObject: classIDString in: iclassObject tags: tagArray
  50.  
  51.       " This is the general method of creating objects from 'boopsi' classes.
  52.       * ('Boopsi' stands for basic object-oriented programming system for
  53.       * Intuition.)
  54.       * 
  55.       * You specify a class either as iclassObject (for a private class) or
  56.       * by its ID string (for public classes).  If iclassObject is nil,
  57.       * then the classIDString is used.  (See BoopsiClassNames.st)
  58.       * 
  59.       * You further specify initial 'create-time' attributes for the
  60.       * object via a TagItem list, and they are applied to the resulting
  61.       * generic data object that is returned.  The attributes, their meanings,
  62.       * attributes applied only at create-time, and required attributes
  63.       * are all defined and documented on a class-by-class basis.
  64.       *
  65.       * RETURNS
  66.       * A boopsi object, which may be used in different contexts such
  67.       * as a gadget or image, and may be manipulated by generic functions.
  68.       * You eventually free the object using the dispose method.
  69.       "
  70.       ^ private <- <primitive 238 1 iclassObject classIDString tagArray>
  71. |
  72.    boopsiName: classNameKey   
  73.  
  74.       " This method is how you obtain classIDStrings.
  75.       * Known class ID String Keys:
  76.       *
  77.       *   classNameKey:     classIDString:
  78.       *   ~~~~~~~~~~~~~     ~~~~~~~~~~~~~~
  79.       *   #ROOTCLASS     is rootclass
  80.       *   #IMAGECLASS    is imageclass
  81.       *   #FRAMEICLASS   is frameiclass
  82.       *   #SYSICLASS     is sysiclass
  83.       *   #FILLRECTCLASS is fillrectclass
  84.       *   #GADGETCLASS   is gadgetclass
  85.       *   #PROPGCLASS    is propgclass
  86.       *   #STRGCLASS     is strgclass
  87.       *   #BUTTONGCLASS  is buttongclass
  88.       *   #FRBUTTONCLASS is frbuttonclass
  89.       *   #GROUPGCLASS   is groupgclass
  90.       *   #ICCLASS       is icclass
  91.       *   #MODELCLASS    is modelclass
  92.       *   #ITEXTICLASS   is itexticlass
  93.       *   #POINTERCLASS  is pointerclass
  94.       "  
  95.       ^ boopsiNames at: classNameKey   
  96. |
  97.    xxxAddBoopsiClass
  98.  
  99.       " You don't need to call this method, makeBoopsiClass:for:id:size:flags: 
  100.       * will take care of it for you!
  101.       "
  102.       <primitive 238 2 iclassObj>
  103. |      
  104.    removeBoopsiClass
  105.  
  106.       " Makes a public class unavailable for public consumption.
  107.       * It's OK to call this function for a class which is not
  108.       * yet in the internal public class list, or has been
  109.       * already removed.
  110.       "
  111.       <primitive 238 3 iclassObj>
  112. |
  113.    freeBoopsiClass ! success !
  114.  
  115.       success <- <primitive 238 4 iclassObj>.
  116.  
  117.       <primitive 250 5 0 iclassObj>. " Too late!  It's all gone! "
  118.       
  119.       ^ success                      " Returns true if successful "
  120. |      
  121.    makeBoopsiClass: classIDString 
  122.                for: superClassObj 
  123.                 id: superClassIDString 
  124.               size: size 
  125.              flags: flags
  126.  
  127.       " Make your own BOOPSI Class.  classID & superClassID can be nil,
  128.       * (which indicates a private BOOPSI Class).  superClassObj
  129.       * should NEVER be nil.  size is the size of the instance data
  130.       * that your class's objects will require, beyond that data defined 
  131.       * for your superclass's objects.  flags should be zero for now 
  132.       * (unless you KNOW otherwise): 
  133.       "
  134.       iclassObj <- <primitive 238 5 classIDString superClassIDString superClassObj size flags>.
  135.  
  136.       self xxxAddBoopsiClass.
  137.  
  138.       ^ iclassObj
  139. |
  140.    obtainGIRPort: gadgetInfoObject  
  141.  
  142.       " Sets up a RastPort for use (only) by custom gadget hook routines.
  143.       * This function must be called EACH time a hook routine needing
  144.       * to perform gadget rendering is called, and must be accompanied
  145.       * by a corresponding call to releaseGIRPort.
  146.       *
  147.       * Note that if a hook function passes you a RastPort pointer,
  148.       * e.g., GM_RENDER, you needn't call obtainGIRPort in that case.
  149.       "
  150.       ^ rastPortObj <- <primitive 238 6 gadgetInfoObject>
  151. |
  152.    releaseGIRPort
  153.  
  154.       " Release a custom gadget RastPort Object from obtainGIRPort: "
  155.  
  156.       <primitive 238 7 rastPortObj>
  157. |
  158.    getAttribute: attrID from: object into: storageObj
  159.  
  160.       ^ <primitive 238 8 attrID object storageObj>
  161. |
  162.    setAttributes: anObject tags: tagArray 
  163.  
  164.       " Specifies a set of attribute/value pairs with meaning as
  165.       * defined by a 'boopsi' object's class.
  166.       *
  167.       * This function does not provide enough context information or
  168.       * arbitration for boopsi gadgets which are attached to windows
  169.       * or requesters.  For those objects, use setGadgetAttributes:from:req:tags:
  170.       *
  171.       * The object does whatever it wants with the attributes you provide.
  172.       * The return value tends to be non-zero if the changes would require
  173.       * refreshing gadget imagery, if anObject is a gadget.
  174.       "
  175.       ^ <primitive 238 9 anObject tagArray>
  176. |
  177.    setGadgetAttributes: gadObj from: winObj req: reqObj tags: tagArray
  178.  
  179.       " Same as setAttributes:tags:, but provides context information and
  180.       * arbitration for classes which implement custom Intuition gadgets.
  181.       *
  182.       * You should use this function for boopsi gadget objects which have
  183.       * already been added to a requester or a window, or for 'models' which
  184.       * propagate information to gadget(s) already added.
  185.       *
  186.       * Typically, the gadgets will refresh their visuals to reflect
  187.       * changes to visible attributes, such as the value of a slider,
  188.       * the text in a string-type gadget, the selected state of a button.
  189.       *
  190.       * You can use this as a replacement for setAttributes:tags:, too,
  191.       * if you specify nil for the 'winObj' and 'reqObj' parameters.
  192.       *
  193.       * The return value tends to be non-zero if the changes would require
  194.       * refreshing gadget imagery, if the object is a gadget.
  195.       "
  196.       ^ <primitive 238 10 gadObj winObj reqObj tagArray>
  197. |
  198.    nextObject: fromObject 
  199.  
  200.       " This function is for boopsi class implementors only.
  201.       *
  202.       * When you collect a set of boopsi objects on an Exec List
  203.       * structure by invoking their OM_ADDMEMBER method, you
  204.       * can (only) retrieve them by iterations of this method.
  205.       *
  206.       * Works even if you remove and dispose the returned list
  207.       * members in turn.
  208.       " 
  209.       ^ <primitive 238 11 fromObject>
  210. |
  211.    doGadgetMethod: gadObj from: winObj req: reqObj message: msgObj
  212.  
  213.       " Same as the DoMethod() function of amiga.lib, but provides context
  214.       * information and arbitration for classes which implement custom
  215.       * Intuition gadgets.  (reqObj can be nil).
  216.       * 
  217.       * You should use this method for boopsi gadget objects,
  218.       * or for 'models' which propagate information to gadgets.
  219.       *
  220.       * The object does whatever it wants with the message you sent,
  221.       * which might include updating its gadget visuals.
  222.       *
  223.       * The return value is defined per-method.
  224.       "
  225.       ^ <primitive 238 12 gadObj winObj reqObj msgObj>
  226. |      
  227.    translateBoopsiErrorNumber " into a String " 
  228.  
  229.       ^ <primitive 238 13>
  230. |
  231.    doSuperMethod: onObject message: msgObj
  232.  
  233.       " msgObj is a struct Msg pointer.
  234.       * Do NOT know if this is needed, but it is included to 
  235.       * complete the functionality of the Class:
  236.       "
  237.       ^ <primitive 238 14 iclassObj onObject msgObj>
  238. |
  239.    coerceMethod: onObject message: msgObj
  240.  
  241.       " msgObj is a struct Msg pointer.
  242.       * Do NOT know if this is needed, but it is included to 
  243.       * complete the functionality of the Class:
  244.       "
  245.       ^ <primitive 238 15 iclassObj onObject msgObj>
  246. ]
  247.  
  248. " -------------------------------------------------------------------- "
  249. " Use this class to create instances of 'itexticlass' BOOPSI Objects.  "
  250. " -------------------------------------------------------------------- "
  251.  
  252. Class BoopsiText :BoopsiImage ! itextObj textColor textOrigin tagArray !
  253. [
  254.    itextString: newITextString
  255.    
  256.      itextObj <- IText new: newITextString
  257. |
  258.    origin: originPoint
  259.    
  260.      textOrigin <- originPoint
  261.      
  262. |
  263.    color: newTextColor
  264.    
  265.      textColor <- newTextColor
  266. |
  267.    initialize: textString at: origin color: newColor
  268.    
  269.      self itextString: textString.
  270.      self origin:      origin.
  271.      self color:       newColor.
  272.      
  273.      ^ self xxxSetup
  274. |
  275.    xxxSetup
  276.  
  277.      " Use initialize:at:color: method after creating an Instance. "
  278.  
  279.      (tagArray isNil)
  280.         ifTrue: [ tagArray <- Array new: 9 ].
  281.      
  282.      itextObj setITextOrigin: textOrigin.
  283.      itextObj setPens:        textColor @ 0.
  284.      
  285.      tagArray at: 1 put: (super boopsiTag: #IA_Data).
  286.      tagArray at: 2 put: itextObj.
  287.      tagArray at: 3 put: (super boopsiTag: #IA_FGPen).
  288.      tagArray at: 4 put: textColor.
  289.      tagArray at: 5 put: (super boopsiTag: #IA_Left).
  290.      tagArray at: 6 put: (textOrigin x).
  291.      tagArray at: 7 put: (super boopsiTag: #IA_Top).
  292.      tagArray at: 8 put: (textOrigin y).
  293.      tagArray at: 9 put: (super boopsiTag: #TAG_DONE).
  294.      
  295.      ^ super newBoopsiObject: (super boopsiName: #ITEXTCLASS) in: nil tags: tagArray.
  296. ]
  297.  
  298. " ---------------------------------------------------------------- "
  299. " This class is an abstract class.  Normally, you do NOT create    "
  300. " instances of this class, just it's subclasses.                   "
  301. " ---------------------------------------------------------------- "
  302.  
  303. Class BoopsiGadget :Boopsi ! gadObj tagArray !
  304. [
  305.    new: numberOfTags
  306.  
  307.      super subclassResponsibility: 'new:'.
  308.  
  309.      ^ nil.
  310. |
  311.    initialize
  312.    
  313.      super subclassResponsibility: 'initialize'.
  314.      
  315.      ^ nil
  316. |
  317.    newBoopsiObject: classIDString
  318.    
  319.      ^ super newBoopsiObject: classIDString in: nil tags: tagArray.
  320. |
  321.    setTagArray: newTagArray
  322.    
  323.      tagArray <- newTagArray.
  324. |
  325.    tagArray
  326.    
  327.      ^ tagArray
  328. |
  329.    origin: originPoint
  330.    
  331.      tagArray at: 2 put: originPoint x.
  332.      tagArray at: 4 put: originPoint y.
  333. |
  334.    extent: sizePoint     
  335.  
  336.      tagArray at: 6 put: sizePoint x.
  337.      tagArray at: 8 put: sizePoint y.
  338. |
  339.    userData: userDataArray ! dataArray size !
  340.    
  341.      size      <- userDataArray size.
  342.  
  343.      dataArray <- Array new: size.
  344.      
  345.      (1 to: size)
  346.         do: [ :i | dataArray at: i put: (userDataArray at: i) ].
  347.         
  348.      tagArray at: 10 put: dataArray.
  349. |
  350.    gadgetIntuiText: itextObj index: tagIndex
  351.  
  352.      " tagIndex has to be >= 11 for this method: "   
  353.  
  354.      tagArray at:  tagIndex      put: (super boopsiTag: #GA_IntuiText).
  355.      tagArray at: (tagIndex + 1) put: itextObj.
  356. |
  357.    gadgetText: textString index: tagIndex
  358.  
  359.      " tagIndex has to be >= 11 for this method: "   
  360.  
  361.      tagArray at:  tagIndex      put: (super boopsiTag: #GA_Text).
  362.      tagArray at: (tagIndex + 1) put: textString.
  363. |
  364.    gadgetLabelImage: imageObj index: tagIndex
  365.  
  366.      " tagIndex has to be >= 11 for this method: "   
  367.  
  368.      tagArray at:  tagIndex      put: (super boopsiTag: #GA_LabelImage).
  369.      tagArray at: (tagIndex + 1) put: imageObj.
  370. |
  371.    gadgetImage: imageObj index: tagIndex
  372.  
  373.      " tagIndex has to be >= 11 for this method: "   
  374.  
  375.      tagArray at:  tagIndex      put: (super boopsiTag: #GA_Image).
  376.      tagArray at: (tagIndex + 1) put: imageObj.
  377. |
  378.    gadgetID: idInteger index: tagIndex
  379.  
  380.      " tagIndex has to be >= 11 for this method: "   
  381.  
  382.      tagArray at:  tagIndex      put: (super boopsiTag: #GA_ID).
  383.      tagArray at: (tagIndex + 1) put: idInteger.
  384. |
  385.    gadgetBorder: borderObj index: tagIndex
  386.  
  387.      " tagIndex has to be >= 11 for this method: "   
  388.  
  389.      tagArray at:  tagIndex      put: (super boopsiTag: #GA_Border).
  390.      tagArray at: (tagIndex + 1) put: borderObj.
  391. |
  392.    gadgetSelectRender: selectObj index: tagIndex
  393.  
  394.      " tagIndex has to be >= 11 for this method: "   
  395.  
  396.      tagArray at:  tagIndex      put: (super boopsiTag: #GA_SelectRender).
  397.      tagArray at: (tagIndex + 1) put: selectObj.
  398. |
  399.    gadgetSpecialInfo: specialObj index: tagIndex
  400.  
  401.      " tagIndex has to be >= 11 for this method: "   
  402.  
  403.      tagArray at:  tagIndex      put: (super boopsiTag: #GA_SpecialInfo).
  404.      tagArray at: (tagIndex + 1) put: specialObj.
  405. |
  406.    gadgetDisabled: boolean index: tagIndex ! ival !
  407.  
  408.      " tagIndex has to be >= 11 for this method: "   
  409.  
  410.      (boolean)
  411.         ifTrue:  [ival <- 1]
  412.         ifFalse: [ival <- 0].
  413.         
  414.      tagArray at:  tagIndex      put: (super boopsiTag: #GA_Disabled).
  415.      tagArray at: (tagIndex + 1) put: ival.
  416. ]
  417.  
  418. Class BoopsiButtonGadget :BoopsiGadget
  419. ! imageObj !
  420. [
  421.    new: numberOfTags ! tagArray !
  422.  
  423.      (numberOfTags < 11)
  424.         ifTrue:  [ tagArray <- Array new: 11 ]
  425.         ifFalse: [ tagArray <- Array new: numberOfTags ]. 
  426.  
  427.      " Minimum required tagArray has to have the following: "
  428.      
  429.      tagArray at:  1 put: (super boopsiTag: #GA_Left).
  430.      tagArray at:  2 put: 0.
  431.      tagArray at:  3 put: (super boopsiTag: #GA_Top).
  432.      tagArray at:  4 put: 0.
  433.      tagArray at:  5 put: (super boopsiTag: #GA_Width).
  434.      tagArray at:  6 put: 50.     
  435.      tagArray at:  7 put: (super boopsiTag: #GA_Height).
  436.      tagArray at:  8 put: 20.
  437.      tagArray at:  9 put: (super boopsiTag: #GA_UserData).     
  438.      tagArray at: 10 put: nil.
  439.      tagArray at: 11 put: (super boopsiTag: #TAG_DONE).     
  440.  
  441.      super setTagArray: tagArray
  442.  
  443.      ^ self
  444. |
  445.    initialize
  446.    
  447.      ^ super newBoopsiObject: (super boopsiName: #BUTTONGCLASS) 
  448. ]
  449.  
  450. Class BoopsiFramedButton :BoopsiButtonGadget
  451. ! frameType !
  452. [
  453.   junk
  454.   
  455.     ^ nil
  456. ]
  457.  
  458. Class BoopsiPropGadget :BoopsiGadget
  459. ! totalSize visibleSize currentValue orientation !
  460. [
  461.   junk
  462.   
  463.     ^ nil
  464. ]
  465.  
  466. Class BoopsiStringGadget :BoopsiGadget
  467. ! font pens maxLength mode justification !
  468. [
  469.   junk
  470.   
  471.     ^ nil
  472. ]
  473.  
  474. " ---------------------------------------------------------------- "
  475. " This class is an abstract class.  Normally, you do NOT create    "
  476. " instances of this class, just it's subclasses.                   "
  477. " ---------------------------------------------------------------- "
  478.  
  479. Class BoopsiImage :Boopsi
  480. ! origin extent pens imageData !
  481. [
  482.   junk
  483.   
  484.     ^ nil
  485. ]
  486.  
  487. Class BoopsiFillRect :BoopsiImage
  488. ! fillPattern drawMode patternSize !
  489. [
  490.   junk
  491.   
  492.     ^ nil
  493. ]
  494.  
  495. Class BoopsiFrame :BoopsiImage
  496. [
  497.   junk
  498.   
  499.     ^ nil
  500. ]
  501.  
  502. Class BoopsiSystemImage :BoopsiImage
  503. ! whichImage drawInfo imageSize !
  504. [
  505.   junk
  506.   
  507.     ^ nil
  508. ]
  509.  
  510. " ---------------------------------------------------------------- "
  511. " The list of available BOOPSI Tags is located in:                 "
  512. " AmigaTalk:prelude/listfiles/BoopsiTags.dictionary                "
  513. " Use this class to make a tagArray for the map instance variable  "
  514. " in BoopsiIC class.                                               "
  515. " ---------------------------------------------------------------- "
  516.  
  517. Class BoopsiMap :TagList
  518. ! numTags tagArray boopsiTags !
  519. [
  520.    new: howManyTags ! intuition !
  521.  
  522.       " Be sure to allow for the #TAG_DONE at the end of your
  523.       * tagArray.  This means that, in general, howManyTags will be
  524.       * an odd number >= 3.
  525.       "
  526.       (intuition isNil)
  527.          ifTrue: [ intuition <- Intuition new ].
  528.          
  529.       (boopsiTags isNil)
  530.          ifTrue: [ boopsiTags <- BoopsiTags new ].
  531.  
  532.       numTags  <- howManyTags.
  533.       
  534.       tagArray <- super new: numTags.
  535.  
  536.       " Make sure tagArray is terminated properly: "
  537.  
  538.       tagArray at: numTags put: (intuition systemTag: #TAG_DONE).
  539.       
  540.       ^ self
  541. |
  542.    setTag: tagSymbol index: arrayIndex
  543.    
  544.       ^ (super setTag: (self xxxBoopsiTag: tagSymbol) index: arrayIndex)
  545. |
  546.    setTagValue: tagSymbol value: newTagValue
  547.    
  548.       (super setTagValue: (self xxxBoopsiTag: tagSymbol) value: newTagValue)
  549. |
  550.    xxxBoopsiTag: tagSymbol
  551.    
  552.       ^ boopsiTags systemTag: tagSymbol
  553. ]
  554.  
  555. Class BoopsiIC :Boopsi
  556. ! target map specialCode !
  557. [
  558.   junk
  559.   
  560.     ^ nil
  561. ]
  562.  
  563. Class BoopsiModel :BoopsiIC
  564. [
  565.   junk
  566.   
  567.     ^ nil
  568. ]
  569.  
  570.